home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Info / For Developers / GhostScript 5.10 / MacGS-510 / files / gs_fonts.ps < prev    next >
Text File  |  1997-08-08  |  28KB  |  913 lines
  1. %    Copyright (C) 1990, 1995, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % Font initialization and management code.
  19.  
  20. % Define the default font.
  21. /defaultfontname /Courier def
  22.  
  23. % Define the name of the font map file.
  24. /defaultfontmap (Fontmap) def
  25.  
  26. % ------ End of editable parameters ------ %
  27.  
  28. % If SUBSTFONT is defined, make it the default font.
  29. /SUBSTFONT where { pop /defaultfontname /SUBSTFONT load def } if
  30.  
  31. % Define a reliable way of accessing FontDirectory in systemdict.
  32. /.FontDirectory
  33. { //systemdict /FontDirectory get
  34. } bind odef
  35.  
  36. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  37. % (This is intended primarily for machines with very small memories.)
  38. % In this case, we define another dictionary, parallel to FontDirectory,
  39. % that retains an open file for every font loaded.
  40. /FontFileDirectory 10 dict def
  41.  
  42. % Define a temporary string for local use, since using =string
  43. % interferes with some PostScript programs.
  44. /.fonttempstring 128 string def
  45.  
  46. % Split up a search path into individual directories or files.
  47. /.pathlist        % <path> .pathlist <dir1|file1> ...
  48.  {  { dup length 0 eq { pop exit } if
  49.       .filenamelistseparator search not { exit } if
  50.       exch pop exch
  51.     }
  52.    loop
  53.  } bind def
  54.  
  55. % Load a font name -> font file name map.
  56. userdict /Fontmap .FontDirectory maxlength dict put
  57. /.loadFontmap        % <file> .loadFontmap -
  58.  {        % We would like to simply execute .definefontmap as we read,
  59.         % but we have to maintain backward compatibility with an older
  60.         % specification that makes later entries override earlier.
  61.    50 dict exch
  62.     { dup token not { closefile exit } if
  63.         % stack: <file> fontname
  64.       % This is a hack to get around the absurd habit of MS-DOS editors
  65.       % of adding an EOF character at the end of the file.
  66.       dup (\032) eq { pop closefile exit } if
  67.       1 index token not
  68.        { (Fontmap entry for ) print dup =only
  69.      ( has no associated file or alias name!  Giving up.\n) print flush
  70.      {.loadFontmap} 0 get 1 .quit
  71.        } if
  72.       dup type dup /stringtype eq exch /nametype eq or not
  73.        { (Fontmap entry for ) print 1 index =only
  74.      ( has an invalid file or alias name!  Giving up.\n) print flush
  75.      {.loadFontmap} 0 get 1 .quit
  76.        } if
  77.         % stack: dict file fontname filename|aliasname
  78.         % Read and pop tokens until a semicolon.
  79.        { 2 index token not
  80.       { (Fontmap entry for ) print 1 index =only
  81.         ( ends prematurely!  Giving up.\n) print flush
  82.         {.loadFontmap} 0 get 1 .quit
  83.       } if
  84.      dup /; eq { pop 3 index 3 1 roll .growput exit } if
  85.      pop
  86.        } loop
  87.     } loop
  88.     { .definefontmap } forall
  89.  } bind def
  90. % Add an entry in Fontmap.  We redefine this if the Level 2
  91. % resource machinery is loaded.
  92. /.definefontmap            % <fontname> <file|alias> .definefontmap -
  93.  {        % Since Fontmap is global, make sure the values are storable.
  94.    .currentglobal 3 1 roll true .setglobal
  95.    dup type /stringtype eq
  96.     { dup .gcheck not { dup length string copy } if
  97.     }
  98.    if
  99.    Fontmap 3 -1 roll 2 copy .knownget
  100.     {        % Add an element to the end of the existing value,
  101.         % unless it's the same as the current last element.
  102.       mark exch aload pop counttomark 4 add -1 roll
  103.       2 copy eq { cleartomark pop pop } { ] readonly .growput } ifelse
  104.     }
  105.     {        % Make a new entry.
  106.       mark 4 -1 roll ] readonly .growput
  107.     }
  108.    ifelse .setglobal
  109.  } bind def
  110.  
  111. % Parse a font file just enough to find the FontName or FontType.
  112. /.findfontvalue        % <file> <key> .findfontvalue <value> true
  113.             % <file> <key> .findfontvalue false
  114.             % Closes the file in either case.
  115.  { exch dup read not { -1 } if
  116.    2 copy unread 16#80 eq
  117.     { dup (xxxxxx) readstring pop pop }        % skip .PFB header
  118.    if
  119.         % Stack: key file
  120.     { dup token not { false exit } if        % end of file
  121.       dup /eexec eq { pop false exit } if    % reached eexec section
  122.       dup /Subrs eq { pop false exit } if    % Subrs without eexec
  123.       dup /CharStrings eq { pop false exit } if    % CharStrings without eexec
  124.       dup 3 index eq
  125.        { xcheck not { dup token exit } if }    % found key
  126.        { pop }
  127.       ifelse
  128.     } loop
  129.         % Stack: key file value true   (or)
  130.         % Stack: key file false
  131.    dup { 4 } { 3 } ifelse -2 roll closefile pop
  132.  } bind def
  133. /.findfontname
  134.  { /FontName .findfontvalue
  135.  } bind def
  136.  
  137. % If there is no FONTPATH, try to get one from the environment.
  138. NOFONTPATH { /FONTPATH () def } if
  139. /FONTPATH where
  140.  { pop }
  141.  { /FONTPATH (GS_FONTPATH) getenv not { () } if def }
  142. ifelse
  143. FONTPATH length 0 eq { (%END FONTPATH) .skipeof } if
  144. /FONTPATH [ FONTPATH .pathlist ] def
  145.  
  146. % Scan directories looking for plausible fonts.  "Plausible" means that
  147. % the file begins with %!PS-AdobeFont or %!FontType1, or with \200\001
  148. % followed by four arbitrary bytes and then either of these strings.
  149. % To speed up the search, we skip any file whose name appears in
  150. % the Fontmap (with any extension and upper/lower case variation) already,
  151. % and any file whose extension definitely indicates it is not a font.
  152. %
  153. % NOTE: The current implementation of this procedure is somewhat Unix/DOS-
  154. % specific.  It assumes that '/' and '\' are directory separators, and that
  155. % the part of a file name following the last '.' is the extension.
  156. %
  157. /.lowerstring        % <string> .lowerstring <lowerstring>
  158.  { 0 1 2 index length 1 sub
  159.     { 2 copy get dup 65 ge exch 90 le and
  160.        { 2 copy 2 copy get 32 add put }
  161.      if pop
  162.     }
  163.    for
  164.  } bind def
  165. /.splitfilename        % <dir.../base.extn> .basename <base> <extn>
  166.  {  { (/) search { true } { (\\) search } ifelse
  167.        { pop pop }
  168.        { exit }
  169.       ifelse
  170.     }
  171.    loop
  172.    dup { (.) search { pop pop } { exit } ifelse } loop
  173.    2 copy eq
  174.     { pop () }
  175.     { exch dup length 2 index length 1 add sub 0 exch getinterval exch }
  176.    ifelse
  177. % Following is debugging code.
  178. %   (*** Split => ) print 2 copy exch ==only ( ) print ==only
  179. %   ( ***\n) print flush
  180.  } bind def
  181. /.scanfontdict 1 dict def        % establish a binding
  182. /.scanfontbegin
  183.  {    % Construct the table of all file names already in Fontmap.
  184.    currentglobal true setglobal
  185.    .scanfontdict dup maxlength Fontmap length 2 add .max .setmaxlength
  186.    Fontmap
  187.     { exch pop
  188.        { dup type /stringtype eq
  189.       { .splitfilename pop .fonttempstring copy .lowerstring cvn
  190.         .scanfontdict exch true put
  191.       }
  192.       { pop
  193.       }
  194.      ifelse
  195.        }
  196.       forall
  197.     }
  198.    forall
  199.    setglobal
  200.  } bind def
  201. /.scanfontskip mark
  202.         % Strings are converted to names anyway, so....
  203.   /afm true
  204.   /bat true
  205.   /c true
  206.   /cmd true
  207.   /com true
  208.   /dll true
  209.   /doc true
  210.   /drv true
  211.   /exe true
  212.   /fon true
  213.   /fot true
  214.   /h true
  215.   /o true
  216.   /obj true
  217.   /pfm true
  218.   /pss true        % Adobe Multiple Master font instances
  219.   /txt true
  220. .dicttomark def
  221. /.scan1fontstring 128 string def
  222. /.scanfontheaders [(%!PS-Adobe*) (%!FontType*)] def
  223. 0 .scanfontheaders { length max } forall 6 add    % extra for PFB header
  224. /.scan1fontfirst exch string def
  225. /.scanfontdir        % <dirname> .scanfontdir -
  226.  { currentglobal exch true setglobal
  227.    QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  228.    (*) 2 copy .filenamedirseparator
  229.    dup (\\) eq { pop (\\\\) } if    % double \ for pattern match
  230.    exch concatstrings concatstrings
  231.    0 0 0 4 -1 roll    % found scanned files
  232.     {        % stack: <fontcount> <scancount> <filecount> <filename>
  233.       exch 1 add exch                   % increment filecount
  234.       dup .splitfilename .lowerstring
  235.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  236.         %    <BASE> <ext>
  237.       .scanfontskip exch known exch .scanfontdict exch known or
  238.        { pop
  239.         % stack: <fontcount> <scancount> <filecount+1>
  240.        }
  241.        { 3 -1 roll 1 add 3 1 roll
  242.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  243.      dup (r) { file } .internalstopped
  244.       { pop pop null ()
  245.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  246.         %    null ()
  247.       }
  248.       {
  249.         % On some platforms, the file operator will open directories,
  250.         % but an error will occur if we try to read from one.
  251.         % Handle this possibility here.
  252.         dup .scan1fontfirst { readstring } .internalstopped
  253.          { pop pop () }
  254.          { pop }
  255.         ifelse
  256.         % stack: <fontcount> <scancount+1> <filecount+1>
  257.         %    <filename> <file> <header>
  258.       }
  259.      ifelse
  260.         % Check for PFB file header.
  261.      dup (\200\001????*) .stringmatch
  262.       { dup length 6 sub 6 exch getinterval }
  263.      if
  264.         % Check for font file headers.
  265.      false .scanfontheaders
  266.       { 2 index exch .stringmatch or
  267.       }
  268.      forall exch pop
  269.       {    % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  270.         %    <file>
  271.         dup 0 setfileposition .findfontname
  272.          { dup Fontmap exch known
  273.         { pop pop
  274.         }
  275.         { exch copystring exch
  276.           DEBUG { ( ) print dup =only } if
  277.           1 index .definefontmap
  278.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  279.             % Increment fontcount.
  280.           3 -1 roll 1 add 3 1 roll
  281.         }
  282.            ifelse
  283.          }
  284.          { pop
  285.          }
  286.         ifelse
  287.       }
  288.         % .findfontname will have done a closefile in the above case.
  289.       { dup null eq { pop } { closefile } ifelse pop
  290.       }
  291.      ifelse
  292.        }
  293.       ifelse
  294.     }
  295.    .scan1fontstring filenameforall
  296.    QUIET
  297.     { pop pop pop }
  298.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  299.       =only ( new fonts.\n) print flush
  300.     }
  301.    ifelse
  302.    setglobal
  303.  } bind def
  304.  
  305. %END FONTPATH
  306.  
  307. % Create the dictionary that registers the .buildfont procedure (called by
  308. % definefont) for each FontType.
  309. /buildfontdict 20 dict def
  310.  
  311. % Register Type 3 fonts, which are always supported, for definefont.
  312. buildfontdict 3 /.buildfont3 cvx put
  313.  
  314. % Register Type 0 fonts if they are supported.  Strictly speaking,
  315. % we should do this in its own file (gs_type0.ps), but since this is
  316. % the only thing that would be in that file, it's simpler to put it here.
  317. /.buildfont0 where { pop buildfontdict 0 /.buildfont0 cvx put } if
  318.  
  319. % Define definefont.  This is a procedure built on a set of operators
  320. % that do all the error checking and key insertion.
  321. /.growfontdict
  322.  {    % Grow the font dictionary, if necessary, to ensure room for an
  323.     % added entry, making sure there is at least one slot left for FID.
  324.    dup maxlength 1 index length sub 2 lt
  325.     { dup dup wcheck
  326.        { .growdict }
  327.        { .growdictlength dict .copydict }
  328.       ifelse
  329.     }
  330.     { dup wcheck not { dup maxlength dict .copydict } if
  331.     }
  332.    ifelse
  333.  } bind def 
  334. /.completefont {
  335.   {        % Check for disabled platform fonts.
  336.       NOPLATFONTS
  337.        {    % Make sure we leave room for FID.
  338.      .growfontdict dup /ExactSize 0 put
  339.        }
  340.        {    % Hack: if the Encoding looks like it might be the
  341.         % Symbol or Dingbats encoding, load those now (for the
  342.         % benefit of platform font matching) just in case
  343.         % the font didn't actually reference them.
  344.      dup /Encoding get length 65 ge
  345.       { dup /Encoding get 64 get
  346.         dup /congruent eq { SymbolEncoding pop } if
  347.         /a9 eq { DingbatsEncoding pop } if
  348.       }
  349.      if
  350.        }
  351.       ifelse
  352.       dup /FontType get //buildfontdict exch get exec
  353.       DISKFONTS
  354.        { FontFileDirectory 2 index known
  355.       { dup /FontFile FontFileDirectory 4 index get .growput
  356.       }
  357.      if
  358.        }
  359.       if
  360.       readonly        % stack: name fontdict
  361.   } stopped { /invalidfont signalerror } if
  362. } bind odef
  363. /definefont
  364.  { .completefont
  365.         % If the current allocation mode is global, also enter
  366.         % the font in LocalFontDirectory.
  367.    .currentglobal
  368.     { //systemdict /LocalFontDirectory .knownget
  369.        { 2 index 2 index .growput }
  370.       if
  371.     }
  372.    if
  373.    dup .FontDirectory 4 -2 roll .growput
  374.  } odef
  375.  
  376. % Define a procedure for defining aliased fonts.
  377. % We can't just copy the font (or even use the same font unchanged),
  378. % because a significant number of PostScript files assume that
  379. % the FontName of a font is the same as the font resource name or
  380. % the key in [Shared]FontDirectory; on the other hand, some Adobe files
  381. % rely on the FontName of a substituted font *not* being the same as
  382. % the requested resource name.  We address this issue heuristically:
  383. % we substitute the new name iff the font name doesn't have MM in it.
  384. /.aliasfont        % <name> <font> .aliasfont <newFont>
  385.  { .currentglobal 3 1 roll dup .gcheck .setglobal
  386.    dup length 2 add dict
  387.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  388.         % Stack: global fontname newfont newfont.
  389.         % We might be defining a global font whose FontName
  390.         % is a local string.  This is weird, but legal,
  391.         % and doesn't cause problems anywhere else:
  392.         % to avoid any possible problems in this case, do a cvn.
  393.         % We might also be defining (as an alias) a global font
  394.         % whose FontName is a local non-string, if someone passed a
  395.         % garbage value to findfont.  In this case, just don't
  396.         % call definefont at all.
  397.    2 index dup type /stringtype eq exch .gcheck or 1 index .gcheck not or
  398.     { 2 index .fonttempstring cvs (MM) search
  399.        { pop pop pop pop
  400.        }
  401.        { /FontName exch dup type /stringtype eq { cvn } if put
  402.        }
  403.       ifelse
  404.         % Don't bind in definefont, since Level 2 redefines it.
  405.       //systemdict /definefont get exec
  406.     }
  407.     { .completefont pop exch pop
  408.     }
  409.    ifelse exch .setglobal
  410.  } odef        % so findfont will bind it
  411.  
  412. % Define .loadfontfile for loading a font.  If we recognize Type 1 and/or
  413. % TrueType fonts, gs_type1.ps and/or gs_ttf.ps will redefine this.
  414. /.loadfontfile { cvx exec } bind def
  415. /.loadfont
  416.  {        % Some buggy fonts leave extra junk on the stack,
  417.         % so we have to make a closure that records the stack depth
  418.         % in a fail-safe way.
  419.    /.loadfontfile cvx count 1 sub 2 packedarray cvx exec
  420.    count exch sub { pop } repeat
  421.  } bind def
  422.  
  423. % Find an alternate font to substitute for an unknown one.
  424. % We go to some trouble to parse the font name and extract
  425. % properties from it.  Later entries take priority over earlier.
  426. /.substitutefaces [
  427.     % Guess at suitable substitutions for random unknown fonts.
  428.   [(Grot) /Times]
  429.   [(Roman) /Times]
  430.   [(Book) /NewCenturySchlbk]
  431.     % If the family name appears in the font name,
  432.     % use a font from that family.
  433.   [(Arial) /Helvetica]
  434.   [(Avant) /AvantGarde]
  435.   [(Bookman) /Bookman]
  436.   [(Century) /NewCenturySchlbk]
  437.   [(Cour) /Courier]
  438.   [(Geneva) /Helvetica]
  439.   [(Helv) /Helvetica]
  440.   [(NewYork) /Times]
  441.   [(Pala) /Palatino]
  442.   [(Sans) /Helvetica]
  443.   [(Schlbk) /NewCenturySchlbk]
  444.   [(Serif) /Times]
  445.   [(Swiss) /Helvetica]
  446.   [(Times) /Times]
  447.   [(Univers) /Helvetica]
  448.     % Substitute for Adobe Multiple Master fonts.
  449.   [(Minion) /Times]
  450.   [(Myriad) /Helvetica]
  451.   [(MyriadPkg) /Helvetica-Narrow]
  452.     % Condensed or narrow fonts map to the only narrow family we have.
  453.   [(Cond) /Helvetica-Narrow]
  454.   [(Narrow) /Helvetica-Narrow]
  455.     % If the font wants to be monospace, use Courier.
  456.   [(Monospace) /Courier]
  457.   [(Typewriter) /Courier]
  458. ] readonly def
  459. /.substituteproperties [
  460.   [(It) 1] [(Oblique) 1]
  461.   [(Bd) 2] [(Bold) 2] [(bold) 2] [(Demi) 2] [(Heavy) 2] [(Sb) 2]
  462. ] readonly def
  463. /.substitutefamilies mark
  464.   /AvantGarde
  465.     {/AvantGarde-Book /AvantGarde-BookOblique
  466.      /AvantGarde-Demi /AvantGarde-DemiOblique}
  467.   /Bookman
  468.     {/Bookman-Demi /Bookman-DemiItalic /Bookman-Light /Bookman-LightItalic}
  469.   /Courier
  470.     {/Courier /Courier-Oblique /Courier-Bold /Courier-BoldOblique}
  471.   /Helvetica
  472.     {/Helvetica /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique}
  473.   /Helvetica-Narrow
  474.     {/Helvetica-Narrow /Helvetica-Narrow-Oblique
  475.      /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique}
  476.   /NewCenturySchlbk
  477.     {/NewCenturySchlbk-Roman /NewCenturySchlbk-Italic
  478.      /NewCenturySchlbk-Bold /NewCenturySchlbk-BoldItalic}
  479.   /Palatino
  480.     {/Palatino-Roman /Palatino-Italic /Palatino-Bold /Palatino-BoldItalic}
  481.   /Times
  482.     {/Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic}
  483. .dicttomark readonly def
  484. /.substitutefont        % <fontname> .substitutefont <altname>
  485.  {    % Look for properties and/or a face name in the font name.
  486.     % If we find any, use Helvetica as the base font;
  487.     % otherwise, use the default font.
  488.     % Note that the "substituted" font name may be the same as
  489.     % the requested one; the caller must check this.
  490.    dup type dup /stringtype eq exch /nametype eq or
  491.     { dup length string cvs } { () } ifelse
  492.     {defaultfontname /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique}
  493.    exch 0 exch    % stack: fontname facelist properties fontname
  494.     % Look for a face name.
  495.    .substitutefaces
  496.     { 2 copy 0 get search
  497.        { pop pop pop 1 get .substitutefamilies exch get
  498.      4 -1 roll pop 3 1 roll
  499.        }
  500.        { pop pop
  501.        }
  502.       ifelse
  503.     }
  504.    forall
  505.    .substituteproperties
  506.     { 2 copy 0 get search
  507.        { pop pop pop 1 get 3 -1 roll or exch }
  508.        { pop pop }
  509.       ifelse
  510.     }
  511.    forall pop get exec
  512.     % Only accept fonts known in the Fontmap.
  513.    Fontmap 1 index known not { pop defaultfontname } if
  514.  } bind def
  515.  
  516. % If requested, make (and recognize) fake entries in FontDirectory for fonts
  517. % present in Fontmap but not actually loaded.  Thanks to Ray Johnston for
  518. % the idea behind this code.
  519. FAKEFONTS not { (%END FAKEFONTS) .skipeof } if
  520.  
  521. % We use the presence or absence of the FontMatrix key to indicate whether
  522. % a font is real or fake.  We must pop the arguments at the very end,
  523. % so that stack protection will be effective.
  524.  
  525. /definefont {        % <name> <font> definefont <font>
  526.   dup /FontMatrix known {
  527.     //definefont
  528.   } {
  529.     2 copy /FontName get findfont //definefont exch pop exch pop
  530.   } ifelse
  531. } bind odef
  532.  
  533. /scalefont {        % <font> <scale> scalefont <font>
  534.   1 index /FontMatrix known {
  535.     //scalefont
  536.   } {
  537.     1 index /FontName get findfont 1 index //scalefont
  538.     exch pop exch pop
  539.   } ifelse
  540. } bind odef
  541.  
  542. /makefont {        % <font> <matrix> makefont <font>
  543.   1 index /FontMatrix known {
  544.     //makefont
  545.   } {
  546.     1 index /FontName get findfont 1 index //makefont
  547.     exch pop exch pop
  548.   } ifelse
  549. } bind odef
  550.  
  551. /setfont {        % <font> setfont -
  552.   dup /FontMatrix known {
  553.     //setfont
  554.   } {
  555.     dup /FontName get findfont //setfont pop
  556.   } ifelse
  557. } bind odef
  558.  
  559. %END FAKEFONTS
  560.  
  561. % Define findfont so it tries to load a font if it's not found.
  562. % The Red Book requires that findfont be a procedure, not an operator,
  563. % but it still needs to restore the stacks reliably if it fails,
  564. % so we do all the work in an operator.
  565. /.findfont {
  566.   mark 1 index
  567.   //systemdict begin .dofindfont
  568.     % Define any needed aliases.
  569.   counttomark 1 sub { .aliasfont } repeat end
  570.   exch pop exch pop
  571. } odef
  572. /findfont {
  573.   .findfont
  574. } bind def
  575. % Check whether the font name we are about to look for is already on the list
  576. % of aliases we're accumulating; if so, cause an error.
  577. /.checkalias        % -mark- <alias1> ... <name> .checkalias <<same>>
  578.  { counttomark 1 sub -1 1
  579.     { index 1 index eq
  580.        { pop QUIET not
  581.       { (Unable to substitute for font.\n) print flush
  582.       } if
  583.      /findfont cvx /invalidfont signalerror
  584.        }
  585.       if
  586.     }
  587.    for
  588.  } bind def
  589. % Get a (non-fake) font if present in a FontDirectory.
  590. /.fontknownget        % <fontdir> <fontname> .fontknownget <font> true
  591.             % <fontdir> <fontname> .fontknownget false
  592.  { .knownget
  593.     { FAKEFONTS
  594.        { dup /FontMatrix known { true } { pop false } ifelse }
  595.        { true }
  596.       ifelse
  597.     }
  598.     { false
  599.     }
  600.    ifelse
  601.  } bind def
  602. % Do the work of findfont, including substitution, defaulting, and
  603. % scanning of FONTPATH.
  604. /.dofindfont        % <fontname> .dofindfont <font>
  605.  {  { .tryfindfont { exit } if
  606.             % We didn't find the font.  If we haven't scanned
  607.             % all the directories in FONTPATH, scan the next one now,
  608.             % and look for the font again.
  609.       null 0 1 FONTPATH length 1 sub
  610.        { FONTPATH 1 index get null ne { exch pop exit } if pop
  611.        }
  612.       for dup null ne
  613.        { dup 0 eq { .scanfontbegin } if
  614.      FONTPATH 1 index get .scanfontdir
  615.      FONTPATH exch null put
  616.             % Start over with an empty alias list.
  617.      counttomark 1 sub { pop } repeat
  618.      .dofindfont exit
  619.        }
  620.       if pop
  621.             % No luck.  Make sure we're not already
  622.             % looking for the default font.
  623.       dup defaultfontname eq
  624.        { QUIET not
  625.       { (Unable to load default font ) print
  626.         dup =only (!  Giving up.\n) print flush
  627.       }
  628.      if /findfont cvx /invalidfont signalerror
  629.        }
  630.       if
  631.             % Substitute for the font.
  632.             % If SUBSTFONT is defined, don't alias.
  633.       /SUBSTFONT where {
  634.     pop QUIET not {
  635.       (Substituting for font ) print dup =only
  636.       (.\n) print flush
  637.     } if
  638.     cleartomark mark defaultfontname
  639.       } {
  640.     dup .substitutefont
  641.     2 copy eq { pop defaultfontname } if
  642.     .checkalias
  643.     QUIET not {
  644.       (Substituting font ) print dup =only ( for ) print
  645.       1 index =only (.\n) print flush
  646.     } if
  647.       } ifelse
  648.     }
  649.    loop
  650.  } bind def
  651. % Try to find a font using only the present contents of Fontmap.
  652. /.tryfindfont        % <fontname> .tryfindfont <font> true
  653.             % <fontname> .tryfindfont false
  654.  { .FontDirectory 1 index .fontknownget
  655.     {            % Already loaded
  656.       exch pop true
  657.     }
  658.     { dup Fontmap exch .knownget not
  659.        {        % Unknown font name.  Look for a file with the
  660.             % same name as the requested font.
  661.      dup dup type /nametype eq { .namestring } if .loadfontloop
  662.        }
  663.        {        % Try each element of the Fontmap in turn.
  664.      false exch    % (in case we exhaust the list)
  665.             % Stack: fontname false fontmaplist
  666.      { exch pop
  667.        dup type /nametype eq
  668.         {            % Font alias
  669.           .checkalias .tryfindfont exit
  670.         }
  671.         { dup dup type dup /arraytype eq exch /packedarraytype eq or exch xcheck and
  672.            {        % Font with a procedural definition
  673.          exec        % The procedure will load the font.
  674.                 % Check to make sure this really happened.
  675.          .FontDirectory 1 index .knownget
  676.           { exch pop true exit }
  677.          if
  678.            }
  679.            {        % Font file name
  680.          .loadfontloop { true exit } if
  681.            }
  682.           ifelse
  683.         }
  684.        ifelse false
  685.      }
  686.      forall
  687.             % Stack: font true -or- fontname false
  688.      { true
  689.      }
  690.      {            % None of the Fontmap entries worked.
  691.                 % Try loading a file with the same name
  692.                 % as the requested font.
  693.        dup dup type /nametype eq { .namestring } if .loadfontloop
  694.      }
  695.     ifelse
  696.        }
  697.       ifelse
  698.     }
  699.    ifelse
  700.  } bind def
  701. % Attempt to load a font from a file.
  702. /.loadfontloop        % <filename> .loadfontloop <font> true
  703.             % <filename> .loadfontloop false
  704.  {            % See above regarding the use of 'loop'.
  705.  
  706.     {
  707.             % Is the font name a string?
  708.     dup type /stringtype ne
  709.      { QUIET not
  710.         { (Can't find font with non-string name: ) print dup =only (.\n) print flush
  711.         }
  712.        if pop false exit
  713.      }
  714.     if
  715.             % Can we open the file?
  716.     findlibfile not
  717.      { QUIET not
  718.         { (Can't find \(or can't open\) font file ) print dup print
  719.           (.\n) print flush
  720.         }
  721.        if pop false exit
  722.      }
  723.     if
  724.  
  725.             % Stack: fontname fontfilename fontfile
  726.     DISKFONTS
  727.      { .currentglobal true .setglobal
  728.        2 index (r) file
  729.        FontFileDirectory exch 5 index exch .growput
  730.        .setglobal
  731.      }
  732.     if
  733.     QUIET not
  734.      { (Loading ) print 2 index =only
  735.        ( font from ) print 1 index print (... ) print flush
  736.      }
  737.     if
  738.     % If LOCALFONTS isn't set, load the font into local or global
  739.     % VM according to FontType; if LOCALFONTS is set, load the font
  740.     % into the current VM, which is what Adobe printers (but not
  741.     % DPS or CPSI) do.
  742.     LOCALFONTS { false } { /setglobal where } ifelse
  743.      { pop /FontType .findfontvalue { 1 eq } { false } ifelse
  744.         % .setglobal, like setglobal, aliases FontDirectory to
  745.         % GlobalFontDirectory if appropriate.  However, we mustn't
  746.         % allow the current version of .setglobal to be bound in,
  747.         % because it's different depending on language level.
  748.        .currentglobal exch /.setglobal load exec
  749.         % Remove the fake definition, if any.
  750.        .FontDirectory 3 index .undef
  751.        1 index (r) file .loadfont .FontDirectory exch
  752.        /.setglobal load exec
  753.      }
  754.      { .loadfont .FontDirectory
  755.      }
  756.     ifelse
  757.         % Stack: fontname fontfilename fontdirectory
  758.     QUIET not
  759.      { //systemdict /level2dict known
  760.         { .currentglobal false .setglobal vmstatus
  761.           true .setglobal vmstatus 3 -1 roll pop
  762.           6 -1 roll .setglobal 5
  763.         }
  764.         { vmstatus 3
  765.         }
  766.        ifelse { =only ( ) print } repeat
  767.        (done.\n) print flush
  768.      } if
  769.  
  770.         % Check to make sure the font was actually loaded.
  771.     dup 3 index .fontknownget
  772.      { 4 1 roll pop pop pop true exit } if
  773.  
  774.         % Maybe the file had a different FontName.
  775.         % See if we can get a FontName from the file, and if so,
  776.         % whether a font by that name exists now.
  777.     exch (r) file .findfontname
  778.      { 2 copy .fontknownget
  779.         {    % Yes.  Stack: origfontname fontdirectory filefontname fontdict
  780.           3 -1 roll pop exch
  781.           QUIET
  782.            { pop
  783.            }
  784.            { (Using ) print =only
  785.              ( font for ) print 1 index =only
  786.              (.\n) print flush
  787.            }
  788.           ifelse true exit
  789.         }
  790.        if pop
  791.      }
  792.     if pop
  793.  
  794.         % The font definitely did not load correctly.
  795.     QUIET not
  796.      { (Loading ) print dup =only
  797.        ( font failed.\n) print flush
  798.      } if
  799.     false exit
  800.  
  801.     } loop        % end of loop
  802.  
  803.  } bind def
  804.  
  805. % Define a procedure to load all known fonts.
  806. % This isn't likely to be very useful.
  807. /loadallfonts
  808.  { Fontmap { pop findfont pop } forall
  809.  } bind def
  810.  
  811. % If requested, load all the fonts defined in the Fontmap into FontDirectory
  812. % as "fake" fonts i.e., font dicts with only FontName and FontType defined.
  813. % (We define FontType only to for the sake of some questionable code in the
  814. % Apple Printer Utility 2.0 font inquiry code.) We must ensure that this
  815. % happens in both global and local directories.
  816. /.definefakefonts
  817.     {
  818.     }
  819.     { (gs_fonts FAKEFONTS) VMDEBUG
  820.       2
  821.     { .currentglobal not .setglobal
  822.       Fontmap
  823.        { pop dup type /stringtype eq { cvn } if
  824.          .FontDirectory 1 index known not
  825.           { 2 dict dup /FontName 3 index put
  826.         dup /FontType 1 put
  827.             .FontDirectory 3 1 roll put
  828.           }
  829.           { pop
  830.           }
  831.          ifelse
  832.        }
  833.       forall
  834.        }
  835.       repeat
  836.     }
  837. FAKEFONTS { exch } if pop def        % don't bind, .current/setglobal get redefined
  838.  
  839. % Install initial fonts from Fontmap.
  840. /.loadinitialfonts
  841.  { NOFONTMAP not
  842.     { /FONTMAP where
  843.       { pop [ FONTMAP .pathlist ]
  844.          { dup VMDEBUG findlibfile
  845.         { exch pop .loadFontmap }
  846.         { /undefinedfilename signalerror }
  847.            ifelse
  848.          }
  849.       }
  850.       { LIBPATH
  851.          { defaultfontmap 2 copy .filenamedirseparator
  852.            exch concatstrings concatstrings dup VMDEBUG
  853.            (r) { file } .internalstopped
  854.         { pop pop } { .loadFontmap } ifelse
  855.          }
  856.       }
  857.      ifelse forall
  858.     }
  859.    if
  860.    .definefakefonts
  861.  } def            % don't bind, .current/setglobal get redefined
  862.  
  863. % ---------------- Synthetic font support ---------------- %
  864.  
  865. % Create a new font by modifying an existing one.  paramdict contains
  866. % entries with the same keys as the ones found in a Type 1 font;
  867. % it should also contain enough empty entries to allow adding the
  868. % corresponding non-overridden entries from the original font dictionary,
  869. % including FID.  If paramdict includes a FontInfo entry, this will
  870. % also override the original font's FontInfo, entry by entry;
  871. % again, it must contain enough empty entries.
  872.  
  873. % Note that this procedure does not perform a definefont.
  874.  
  875. /.makemodifiedfont    % <fontdict> <paramdict> .makemodifiedfont <fontdict'>
  876.  { exch
  877.     {            % Stack: destdict key value
  878.       1 index /FID ne
  879.        { 2 index 2 index known
  880.       {        % Skip fontdict entry supplied in paramdict, but
  881.             % handle FontInfo specially.
  882.         1 index /FontInfo eq
  883.          { 2 index 2 index get        % new FontInfo
  884.            1 index                % old FontInfo
  885.         {    % Stack: destdict key value destinfo key value
  886.           2 index 2 index known
  887.            { pop pop }
  888.            { 2 index 3 1 roll put }
  889.           ifelse
  890.         }
  891.            forall pop
  892.          }
  893.         if
  894.       }
  895.       {        % No override, copy the fontdict entry.
  896.         2 index 3 1 roll put
  897.         dup dup    % to match pop pop below
  898.       }
  899.      ifelse
  900.        }
  901.       if
  902.       pop pop
  903.     } forall
  904.  } bind def
  905.  
  906. % Make a modified font and define it.  Note that unlike definefont,
  907. % this does not leave the font on the operand stack.
  908.  
  909. /.definemodifiedfont    % <fontdict> <paramdict> .definemodifiedfont -
  910.  { .makemodifiedfont
  911.    dup /FontName get exch definefont pop
  912.  } bind def
  913.